home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / TPTUTR0F.ZIP / PASCAL18.TXT < prev    next >
Text File  |  1996-03-03  |  32KB  |  938 lines
  1.                        Turbo Pascal for DOS Tutorial
  2.                             by Glenn Grotzinger
  3.           Part 18: Chained or Linked lists, the linked list sort
  4.                 copyright(c) 1995-96 by Glenn Grotzinger
  5.  
  6. Here is a solution from last time...
  7.  
  8. {$M 64000,0,655360}
  9. program part17; uses crt;
  10.  
  11.   type
  12.     arptr = ^atype;
  13.     atype = array[1..15000] of integer;
  14.   var
  15.     a: arptr;
  16.     number: integer;
  17.     c, i, j, PIVOT, t: integer;
  18.     found: boolean;
  19.     location: integer;
  20.     outfile: text;
  21.  
  22.   procedure quicksort(L, R: integer);
  23.     { nothing to say we couldn't sort the data... }
  24.     begin
  25.       if wherex = 79 then
  26.         begin
  27.           gotoxy(1, wherey);
  28.           clreol;
  29.         end
  30.       else
  31.         write(#254);
  32.  
  33.       if L < R then
  34.         begin
  35.           i := L + 1;
  36.           j := R;
  37.           PIVOT := A^[L];
  38.  
  39.           repeat
  40.             while a^[i] <= PIVOT do inc(i);
  41.             while a^[j] > PIVOT do dec(j);
  42.             if i < j then
  43.               begin
  44.                 t := A^[i];
  45.                 A^[i] := a^[j];
  46.                 A^[j] := t;
  47.               end;
  48.           until i > j;
  49.  
  50.           a^[l] := A^[j];
  51.           a^[j] := PIVOT;
  52.  
  53.           quicksort(L, j-1);
  54.           quicksort(i, R);
  55.         end;
  56.     end;
  57.  
  58.   procedure bsearch(number, lowend, highend: integer; var found: boolean);
  59.     var
  60.       midpoint: integer;
  61.     begin
  62.       if lowend > highend then
  63.         found := false
  64.       else
  65.         begin
  66.           midpoint := (lowend + highend) div 2;
  67.           if number = a^[midpoint] then
  68.             begin
  69.               found := true;
  70.               location := midpoint;
  71.             end
  72.           else if number < a^[midpoint] then
  73.             bsearch(number, lowend, midpoint-1, found)
  74.           else if number > a^[midpoint] then
  75.             bsearch(number, midpoint+1, highend, found);
  76.         end;
  77.     end;
  78.  
  79.   begin
  80.     if maxavail - sizeof(a) > 0 then
  81.       new(a)
  82.     else
  83.       begin
  84.         writeln('Out of memory!');
  85.         halt(1);
  86.       end;
  87.     randomize;
  88.     assign(outfile, 'LOCAT2.TXT');
  89.     rewrite(outfile);
  90.  
  91.     for c := 1 to 15000 do
  92.       a^[c] := random(25000) + 1;
  93.  
  94.     quicksort(1, 15000);
  95.  
  96.     for c := 1 to 15000 do
  97.       begin
  98.         number := random(25000) + 1;
  99.         bsearch(number, 1, 15000, found);
  100.         if found then
  101.           writeln(outfile, c, ') ', number, ' was found at position ',
  102.                   location, '.');
  103.       end;
  104.     dispose(a);
  105.     close(outfile);
  106.  
  107. end.
  108.  
  109. Here is the solution I got from part 10...No one tried it and sent it to me.
  110. Here's the UNIT.  Keep in mind that I said to JUST CREATE ONE.  You don't
  111. have to have the same functions that I had in there.  Just as long as it
  112. works....
  113.  
  114. {$O+}
  115. unit unit10;
  116.  
  117.   interface
  118.   type
  119.     strtype = array[1..3] of string[80];
  120.     {$I COMPHVN.INC}
  121.  
  122.     function numeric(str: string): boolean;
  123.     procedure writerecord(var outfile: file; strs: strtype);
  124.  
  125.   implementation
  126.  
  127.   function numeric(str: string): boolean;
  128.     var
  129.       num: boolean;
  130.       i: integer;
  131.  
  132.     begin
  133.       i := 1;
  134.       num := true;
  135.       while (num) and (i <= length(str)) do
  136.         begin
  137.           num := (str[i] in ['0'..'9','.',' ']);
  138.           inc(i);
  139.         end;
  140.       numeric := num;
  141.     end;
  142.  
  143.   procedure writerecord(var outfile: file; strs: strtype);
  144.     var
  145.       numerr: integer;
  146.       writerec: comphvndata;
  147.     begin
  148.       with writerec do
  149.         begin
  150.           {part 1}
  151.           datacode := copy(strs[1], 1, 7);
  152.           acct_classification := strs[1][8];
  153.           val(copy(strs[1], 10, 3), phone_area, numerr);
  154.           val(copy(strs[1], 13, 3), phone_prefix, numerr);
  155.           val(copy(strs[1], 16, 4), phone_exchange, numerr);
  156.           val(copy(strs[1], 20, 3), work_area, numerr);
  157.           val(copy(strs[1], 23, 3), work_prefix, numerr);
  158.           val(copy(strs[1], 26, 4), work_exchange, numerr);
  159.           val(copy(strs[1], 30, 3), other_area, numerr);
  160.           val(copy(strs[1], 33, 3), other_prefix, numerr);
  161.           val(copy(strs[1], 36, 4), other_exchange, numerr);
  162.           cnct1_lname := copy(strs[1], 40, 16);
  163.           cnct1_fname := copy(strs[1], 56, 11);
  164.           cnct1_minit := strs[1][67];
  165.           val(copy(strs[1], 68, 5), cnct1_pobox, numerr);
  166.           cnct1_sname := copy(strs[1], 73, 8);
  167.  
  168.           {part2}
  169.           accept_check := (strs[2][8] = 'Y');
  170.           cnct1_stype := copy(strs[2], 10, 4);
  171.           val(copy(strs[2], 14, 4), cnct1_apt, numerr);
  172.           cnct1_city := copy(strs[2], 18, 10);
  173.           cnct1_state := copy(strs[2], 28, 2);
  174.           val(copy(strs[2], 30, 9), cnct1_zip, numerr);
  175.           val(copy(strs[2], 39, 2), cnct1_birthm, numerr);
  176.           val(copy(strs[2], 41, 2), cnct1_birthd, numerr);
  177.           val(copy(strs[2], 43, 4), cnct1_birthy, numerr);
  178.           val(copy(strs[2], 47, 9), balnce_credt, numerr);
  179.           val(copy(strs[2], 56, 8), total_sold, numerr);
  180.           cnct1_emp_code := copy(strs[2], 64, 4);
  181.           val(copy(strs[2], 68, 3), total_sales, numerr);
  182.           emp_name := copy(strs[2], 71, 10);
  183.  
  184.           {part3}
  185.           accept_credt := (strs[3][8] = 'Y');
  186.           val(copy(strs[3], 10, 4), emp_stnum, numerr);
  187.           emp_sttype := copy(strs[3], 14, 4);
  188.           emp_city := copy(strs[3], 18, 10);
  189.           emp_state := copy(strs[3], 28, 2);
  190.           val(copy(strs[3], 39, 3), emp_area, numerr);
  191.           val(copy(strs[3], 42, 3), emp_prefix, numerr);
  192.           val(copy(strs[3], 45, 4), emp_exchange, numerr);
  193.           val(copy(strs[3], 49, 2), emp_yrs, numerr);
  194.           compu := (strs[3][51] = 'Y');
  195.           compu_type := copy(strs[3], 52, 9);
  196.           compu_mon := strs[3][61];
  197.           compu_cdr := (strs[3][62] = 'Y');
  198.           compu_cdt := strs[3][63];
  199.           val(copy(strs[3], 64, 2), compu_mem, numerr);
  200.           minor := (strs[3][66] = 'Y');
  201.         end;
  202.         blockwrite(outfile, writerec, sizeof(writerec));
  203.       end;
  204.  
  205.   end.
  206. And now here is the main program I got for part 10.  What I can see that is
  207. not readily explainable here (I used every method I could think of that
  208. falls into the rules I outlined for the thing.).  The two compiler directives
  209. you see below turn off stack checking and range checking respectively.
  210. With regards to data intensive applications such as sorting, large #'s of
  211. comparisons, and so forth, adding these speeds it up.
  212.  
  213. {$S-}
  214. {$R-}
  215. program part10; uses dos, unit10, overlay;
  216.  
  217.   {$O UNIT10.TPU}
  218.   var
  219.     strs: strtype;
  220.     outfile: file;
  221.     infile, errfile: text;
  222.     i: integer;
  223.     errwritten: boolean;
  224.  
  225.   procedure writeerror(errline, errtype: string);
  226.     var
  227.       temp1: string;
  228.     begin
  229.       temp1 := copy(errline, 1, 20);
  230.       writeln(errfile, temp1,'':10, errtype);
  231.       errwritten := true;
  232.     end;
  233.  
  234.   function checkstatus(strs: strtype): boolean;
  235.     var
  236.       check: boolean;
  237.       seqs: array[1..3] of char;
  238.       cnts: array[1..3] of byte;
  239.       i: byte;
  240.       errtype: string;
  241.     begin
  242.       check := true;
  243.       for i := 1 to 3 do
  244.         cnts[i] := 0;
  245.       for i := 1 to 3 do
  246.         begin
  247.           seqs[i] := strs[i][9];
  248.           case seqs[i] of
  249.             '1': inc(cnts[1]);
  250.             '2': inc(cnts[2]);
  251.             '3': inc(cnts[3]);
  252.           end;
  253.         end;
  254.       for i := 1 to 3 do
  255.         begin
  256.           if cnts[i] = 0 then
  257.             begin
  258.               errtype := 'Missing line #' + chr(i+48);
  259.               writeerror(strs[i], errtype);
  260.               check := false;
  261.             end;
  262.           if cnts[i] = 2 then
  263.             begin
  264.               errtype := 'Duplicate line #' + chr(i+48);
  265.               writeerror(strs[i], errtype);
  266.               check := false;
  267.             end;
  268.         end;
  269.       checkstatus := check;
  270.     end;
  271.  
  272.   procedure checkdatacodes(strs: strtype);
  273.     var
  274.       datacodes: array[1..3] of string[7];
  275.       check1: string[5];
  276.       check2: char;
  277.       error: string[20];
  278.     begin
  279.       for i := 1 to 3 do
  280.         datacodes[i] := copy(strs[i], 1, 7);
  281.       check1 := copy(strs[1], 40, 5);
  282.       check2 := strs[1][56];
  283.       for i := 1 to 3 do
  284.         begin
  285.           if datacodes[i][6] <> '*' then
  286.             writeerror(strs[i], 'Invalid datacode.');
  287.           if (check1 <> copy(datacodes[i], 1, 5)) or
  288.              (check2 <> datacodes[i][7]) then
  289.             writeerror(strs[i], 'Datacode does not agree with name.');
  290.         end;
  291.     end;
  292.  
  293.   procedure checknumeric(strs: strtype);
  294.     var
  295.       temp1, temp2: string;
  296.       int, numerr, numdiff: integer;
  297.       year, month, day, dayofweek: word;
  298.       empyrs, birthy, bmo, bday: word;
  299.       age: byte;
  300.       isminor: boolean;
  301.  
  302.     begin
  303.       if numeric(copy(strs[1], 10, 3)) = false then
  304.         writeerror(strs[1], 'Phone-area is not numeric.');
  305.       if numeric(copy(strs[1], 13, 3)) = false then
  306.         writeerror(strs[1], 'Phone-prefix is not numeric.');
  307.       if numeric(copy(strs[1], 16, 4)) = false then
  308.         writeerror(strs[1], 'Phone-exchange is not numeric.');
  309.       if numeric(copy(strs[1], 20, 3)) = false then
  310.         writeerror(strs[1], 'Work-area is not numeric.');
  311.       if numeric(copy(strs[1], 23, 3)) = false then
  312.         writeerror(strs[1], 'Work-prefix is not numeric.');
  313.       if numeric(copy(strs[1], 26, 4)) = false then
  314.         writeerror(strs[1], 'Work-exchange is not numeric.');
  315.       if numeric(copy(strs[1], 30, 3)) = false then
  316.         writeerror(strs[1], 'Other-area is not numeric.');
  317.       if numeric(copy(strs[1], 33, 3)) = false then
  318.         writeerror(strs[1], 'Other-prefix is not numeric.');
  319.       if numeric(copy(strs[1], 36, 4)) = false then
  320.         writeerror(strs[1], 'Other-exchange is not numeric.');
  321.       if numeric(copy(strs[1], 68, 5)) = false then
  322.         writeerror(strs[1], 'cnct1-pobox is not numeric.');
  323.       if numeric(copy(strs[3], 30, 9)) = false then
  324.         writeerror(strs[3], 'emp-zip is not numeric.');
  325.       if numeric(copy(strs[3], 39, 3)) = false then
  326.         writeerror(strs[3], 'emp-area is not numeric.');
  327.       if numeric(copy(strs[3], 42, 3)) = false then
  328.         writeerror(strs[3], 'emp-prefix is not numeric.');
  329.       if numeric(copy(strs[3], 45, 4)) = false then
  330.         writeerror(strs[3], 'emp-exchange is not numeric.');
  331.       temp2 := copy(strs[3], 49, 2);
  332.       if numeric(temp2) = false then
  333.         writeerror(strs[3], 'emp-yrs is not numeric.')
  334.       else
  335.         val(temp2, empyrs, numerr);
  336.       if numeric(copy(strs[2], 30, 9)) = false then
  337.         writeerror(strs[2], 'cnct1-zip is not numeric.');
  338.       temp2 := copy(strs[2], 39, 2);
  339.       if numeric(temp2) = false then
  340.         writeerror(strs[2], 'cnct1-birthm is not numeric.')
  341.       else
  342.         val(temp2, bmo, numerr);
  343.       temp2 := copy(strs[2], 41, 2);
  344.       if numeric(temp2) = false then
  345.         writeerror(strs[2], 'cnct1-birthd is not numeric.')
  346.       else
  347.         val(temp2, bday, numerr);
  348.  
  349.       temp1 := copy(strs[2], 43, 4);
  350.       if numeric(temp1) = false then
  351.         writeerror(strs[2], 'cnct1-birthy is not numeric.')
  352.       else
  353.         begin
  354.           val(temp1, int, numerr);
  355.           if (int < 1900) or (int > 1999) then
  356.             writeerror(strs[2], 'cnct1-birthy is not in this century.');
  357.         end;
  358.  
  359.       getdate(year, month, day, dayofweek);
  360.       val(temp1, birthy, numerr);
  361.       numdiff := year - birthy;
  362.       if numdiff < empyrs then
  363.         writeerror(strs[3], 'The emp-yrs doesn''t make sense.');
  364.  
  365.       age := year - birthy;
  366.       if month < bmo then dec(age);
  367.       if month = bmo then
  368.         if day < bday then
  369.           dec(age);
  370.       isminor := (age < 21);
  371.       if ((isminor = true) and (strs[3][66] = 'N')) or
  372.          ((isminor = false) and (strs[3][66] = 'Y')) then
  373.         writeerror(strs[3], 'Minor is set incorrectly.');
  374.  
  375.  
  376.       if numeric(copy(strs[2], 47, 9)) = false then
  377.         writeerror(strs[2], 'balance-credt is not numeric.');
  378.       if numeric(copy(strs[2], 56, 8)) = false then
  379.         writeerror(strs[2], 'total-sold is not numeric.');
  380.       if numeric(copy(strs[2], 68, 3)) = false then
  381.         writeerror(strs[2], 'total-sales is not numeric.');
  382.       if numeric(copy(strs[3], 64, 2)) = false then
  383.         writeerror(strs[3], 'compu-mem is not numeric.');
  384.     end;
  385.  
  386.  procedure checkprefix(strs: strtype);
  387.    begin
  388.      if strs[1][13] in ['0'..'1'] then
  389.        writeerror(strs[1], 'phone-prefix started with a 0 or 1.');
  390.      if strs[1][23] in ['0'..'1'] then
  391.        writeerror(strs[1], 'work-prefix started with a 0 or 1.');
  392.      if strs[1][33] in ['0'..'1'] then
  393.        writeerror(strs[1], 'other-prefix started with a 0 or 1.');
  394.      if strs[3][42] in ['0'..'1'] then
  395.        writeerror(strs[3], 'emp-prefix started with a 0 or 1.');
  396.    end;
  397.  
  398.  procedure checkacct(strs: strtype);
  399.    begin
  400.      if strs[1][8] in ['B','C','G','P','O'] then
  401.      else
  402.        writeerror(strs[1], 'acct-classification is invalid.');
  403.    end;
  404.  
  405.  procedure checkyn(strs: strtype);
  406.    begin
  407.      if strs[2][8] in ['Y', 'N'] then
  408.      else
  409.        writeerror(strs[2], 'accept-check is invalid.');
  410.      if strs[3][8] in ['Y', 'N'] then
  411.      else
  412.        writeerror(strs[3], 'accept-credt is invalid.');
  413.      if strs[3][51] in ['Y', 'N'] then
  414.      else
  415.        writeerror(strs[3], 'compu is invalid.');
  416.      if strs[3][62] in ['Y', 'N'] then
  417.      else
  418.        writeerror(strs[3], 'compu-cdr is invalid.');
  419.      if strs[3][66] in ['Y', 'N'] then
  420.      else
  421.        writeerror(strs[3], 'minor is invalid.');
  422.    end;
  423.  
  424.  procedure checkcompun(strs: strtype);
  425.    begin
  426.      if strs[3][51] = 'N' then
  427.        if (copy(strs[3], 52, 14) <> '            0 ') then
  428.          writeerror(strs[3], 'There were fields present when compu was N.');
  429.    end;
  430.  
  431.  procedure checkempcode(strs: strtype);
  432.    begin
  433.      if copy(strs[2], 64, 4) = 'RET ' then
  434.        if (copy(strs[2], 71, 10) <> '          ') and
  435.           (copy(strs[3], 10, 20) <> '0                   ') and
  436.           (copy(strs[3], 30, 20) <> '0         0  0  0   ') then
  437.           writeerror(strs[3], 'empcodes are present when RET is true.');
  438.    end;
  439.  
  440.  procedure checkcompumon(strs: strtype);
  441.    begin
  442.      if strs[3][61] in ['S','V','E','C','H','I'] then
  443.      else
  444.        writeerror(strs[3], 'compu-mon is invalid.');
  445.    end;
  446.  
  447.  procedure checkcompucdt(strs:strtype);
  448.    begin
  449.      if strs[3][63] in ['1','2','4','6','8'] then
  450.      else
  451.        writeerror(strs[3], 'compu-cdt is invalid.');
  452.    end;
  453.  
  454.  procedure checksttype(strs: strtype);
  455.    var
  456.      a: string;
  457.    begin
  458.      a:=copy(strs[3], 14, 4);
  459.      if (a <> 'BLVD') and (a <> 'LANE') and (a <> 'ST  ') and (a <> 'AVE ')
  460.        and (a <> 'CT  ') and (a <> 'LOOP') and (a <> 'DR  ') and
  461.        (a <> 'CIRC') and (a <> 'RR  ') then
  462.        writeerror(strs[3], 'emp-sttype is invalid.');
  463.      a:=copy(strs[2], 10, 4);
  464.      if (a <> 'BLVD') and (a <> 'LANE') and (a <> 'ST  ') and (a <> 'AVE ')
  465.        and (a <> 'CT  ') and (a <> 'LOOP') and (a <> 'DR  ') and
  466.        (a <> 'CIRC') and (a <> 'RR  ') then
  467.        writeerror(strs[2], 'cnct1-stype is invalid.');
  468.    end;
  469.  
  470.  procedure writeheader;
  471.    begin
  472.      writeln(errfile, 'Error Report -- INDATA.TXT':50);
  473.      writeln(errfile, '--------------------------':50);
  474.      writeln(errfile);
  475.      writeln(errfile, 'First 20 characters','':10, 'Problem');
  476.      writeln(errfile, '-------------------','':10, '-------');
  477.    end;
  478.  
  479.  begin
  480.    ovrinit('PART10.OVR');
  481.    if ovrresult <> 0 then
  482.      begin
  483.        case ovrresult of
  484.          -1: writeln('Overlay manager error.');
  485.          -2: writeln('Overlay file not found.');
  486.          -3: writeln('Not enough memory for overlay buffer.');
  487.          -4: writeln('Overlay I/O error.');
  488.        end;
  489.        halt(1);
  490.      end;
  491.    ovrinitems;
  492.    case ovrresult of
  493.       0: writeln('Overlay loaded to EMS memory!');
  494.      -5: writeln('No EMS driver found! Loading to conventional memory!');
  495.      -6: writeln('Not enough EMS memory to load! Loading to conventional',
  496.                  ' memory!');
  497.    end;
  498.    assign(infile, 'INDATA.TXT');
  499.    reset(infile);
  500.    assign(errfile, 'ERRORS.LOG');
  501.    rewrite(errfile);
  502.    assign(outfile, 'COMPHVN.DAT');
  503.    rewrite(outfile, 1);
  504.    writeheader;
  505.    while not eof(infile) do
  506.      begin
  507.        errwritten := false;
  508.        for i := 1 to 3 do
  509.          readln(infile, strs[i]);
  510.        if checkstatus(strs) then
  511.          begin
  512.            checkdatacodes(strs);
  513.            checknumeric(strs);
  514.            checkprefix(strs);
  515.            checkacct(strs);
  516.            checkyn(strs);
  517.            checkempcode(strs);
  518.            checkcompun(strs);
  519.            checkcompumon(strs);
  520.            checkcompucdt(strs);
  521.            checksttype(strs);
  522.          end;
  523.        if errwritten = false then
  524.          writerecord(outfile, strs);
  525.      end;
  526.    close(infile);
  527.    close(errfile);
  528.    close(outfile);
  529.  end.
  530.  
  531.  
  532. Now we will discuss the idea of the linked list or chained list.  Basically,
  533. there are 4 types of linked lists that we can discuss, the singularly linked
  534. linear list (SLLL), singularly linked circular list (SLCL), doubly linked
  535. linear list (DLLL), and the doubly linked circular list (DLCL).  I will
  536. use the abbreviations I placed in the parentheses for any future references
  537. to these data types.
  538.  
  539. These are basically the preferred ways to allocate large amounts of storage
  540. space on the heap.  All linked lists are basically describable in the best
  541. analogy as a chain.  They are record structures which have pointers that
  542. interconnect them.  The method that these structures are connected
  543. distinguish the type of linked list it is.  We will look at an example of
  544. the use of SLLL's, observe the advantages of linked lists through what we
  545. do with the example, and study the things to look out for on all 4 types.
  546.  
  547. SLLL Concepts
  548. =============
  549. This is the simplest type, in sense.  It involves a record structure which
  550. is connected in a chain in a linear fashion with one link forward to the
  551. next link.  A sample record structure for an SLLL follows below.
  552.  
  553. type
  554.   nodeptr = ^node;
  555.   nodetype = record
  556.     ourinfo: integer;
  557.     nextnode: nodeptr;
  558.   end;
  559.  
  560. An example of an SLLL conceptually is something like this:
  561.  
  562. NODE-->NODE-->NODE-->NODE-->NODE-->NODE-->NODE-->nil
  563.  
  564. As we remember from earlier, nil is what we set a pointer to, if we do not
  565. want it to point to anything...In the use of an SLLL, it is also what we
  566. will use to indicate whether we are at the end of the list or not.
  567.  
  568. We will see from the slll_demo program that there are several specialized
  569. issues we need to take into consideration with working with any linked or
  570. chained list.
  571.  
  572. 1) We need to make a special case to insert or delete a node from the start
  573. of the list.
  574. 2) We need to be sure to maintain nil pointers in any insert or delete
  575. operation.
  576. 3) NEVER NEVER NEVER WORK DIRECTLY WITH THE HEAD TRACKING POINTER WE
  577. ORIGINALLY ALLOCATE UNLESS WE DESIGN OUR CODE COMPLETELY AROUND RECURSION.
  578. As a result, you will cause what is called a heap leak.  This is where
  579. the pointer loses track of where the data it points to is stored.  Logically,
  580. looking at the model above, if we disconnect one of the pointers, represented
  581. by the arrows, we lose track of the rest of the list, or chain.  Work with
  582. a temporary pointer for each linked list function. What I say by recursion,
  583. you will see later in this document.
  584. 4) With regards to the example I wrote, I tried to demonstrate any and all
  585. functions that we might need with an SLLL.
  586. 5) Pointers that point at nil CAN NOT be deallocated.  You will see this
  587. fact manifest itself by the memory statement at the end being 8 bytes
  588. smaller than it was at the start.
  589.  
  590. SLLLs Demonstrated
  591. ==================
  592. Here is the SLLL_DEMO program.  I will place stop notes in there, as well
  593. as comments.
  594.  
  595. Advantages of linked lists: We will see here, that the data is not static,
  596. we can place data independently at different positions WITHOUT shuffling
  597. data, remove data in the same fashion, and definitely are capable of handling
  598. *A LOT* more data than 64KB, since we only have a 4 byte stub in that area.
  599.  
  600. Take a good look at this program and seek to understand EXACTLY how it works.
  601. As you will remember from last time, a direct assignment to a pointer is
  602. making it point to something while a reference to the pointer (via ^) changes
  603. the contents of the data it points to.  I recommend you draw out what is
  604. going on via pencil and paper, using boxes to represent the records and
  605. arrows representing pointers.  It will help you VASTLY to do this in
  606. understanding what is going on.  Remember a pointer can only point to one
  607. thing at a time.  When you look at this program, seek to answer the
  608. following questions taking any "housekeeping functions" out of consideration:
  609.  
  610. 1) Why is the insert code different than the build code?
  611. 2) Why is the delete code different than the cleanup code?
  612. 3) On the "divisible by 8" search, why is the NEXT node being searched for
  613. this and not the current node?
  614. 4) Why did I say to always use a temporary variable? Or Why does the
  615. statement p := list; always occur?
  616. 5) Observe methods of moving through the list.
  617.  
  618. program slll_demo; uses crt;
  619.  
  620.   { Program written by Glenn Grotzinger for a demonstration of all of the
  621.     functions/uses of a linked list that the author could think of.
  622.     the variable used throughout called p, and sometimes t, are temporary
  623.     variables.
  624.  
  625.     Note: This probably isn't completely optimized. }
  626.  
  627.   type
  628.     nodeptr = ^nodetype;
  629.     nodetype = record
  630.       thenum: integer;
  631.       nextnode: nodeptr;
  632.     end;
  633.  
  634.   var
  635.     list: nodeptr;
  636.  
  637.   procedure buildlist(var list: nodeptr);
  638.  
  639.     { This procedure builds up the list for us. }
  640.  
  641.     var
  642.       p: nodeptr;
  643.       i: integer;
  644.     begin
  645.       new(list);       { This is creating the head of the list }
  646.       list^.thenum := 1;
  647.       p := list;       { Set and move temporary pointer }
  648.       for i := 2 to 18 do
  649.         begin
  650.           new(p^.nextnode);
  651.           p^.nextnode^.thenum := i;
  652.           p := p^.nextnode;
  653.          { p := p^.nextnode advances the temporary pointer to the next node.
  654.            this is a memory storage address or pointer and not a direct
  655.            variable, referencing a node of the linked list.  Anything, in
  656.            reality does not become a pointer until the new function is used. }
  657.         end;
  658.       p^.nextnode := nil;   { set last pointer to nothing }
  659.     end;
  660.  
  661.   procedure writelist(list: nodeptr);
  662.  
  663.     { This procedure serves the function of writing out the list for us
  664.       to the screen when called }
  665.  
  666.     var
  667.       p: nodeptr;
  668.     begin
  669.       p := list;
  670.       while p <> nil do { while we're not at the end of the list }
  671.         begin
  672.           write(p^.thenum:3);
  673.           p := p^.nextnode;
  674.         end;
  675.     end;
  676.  
  677.   procedure insert(var list: nodeptr);
  678.  
  679.     { This procedure will serve to insert a node into the list either in
  680.       the middle or the end.  The logic can be done for the head of the
  681.       list. }
  682.  
  683.     var
  684.       p: nodeptr;
  685.     begin
  686.       new(p);
  687.       p^.thenum := 20;
  688.       p^.nextnode := list;
  689.       if p^.nextnode = nil then  { maintenance of the end of list marker }
  690.         p^.nextnode^.nextnode := nil;
  691.       list := p;
  692.     end;
  693.  
  694.   procedure delete(var list: nodeptr);
  695.     { This is a procedure that will serve to delete a node from the list,
  696.       and consequently deallocate the memory.  It is possible to remove
  697.       the node without deallocating the memory, though it is a bad practice
  698.       to do so }
  699.  
  700.     var
  701.       p, t: nodeptr;
  702.     begin
  703.       p := list;
  704.       t := p^.nextnode^.nextnode;
  705.       dispose(p^.nextnode);
  706.       p^.nextnode := t;
  707.     end;
  708.  
  709.   procedure insertbythree(var list: nodeptr);
  710.  
  711.     { This procedure moves through the linked list and determines where
  712.       the new nodes needs to be inserted, then calls the insert function
  713.       written before }
  714.  
  715.     var
  716.       p: nodeptr;
  717.       i: integer;
  718.     begin
  719.       p := list;
  720.       i := 1;
  721.       while p <> nil do
  722.         begin
  723.           p := p^.nextnode;
  724.           inc(i);
  725.           if i mod 3 = 0 then
  726.             insert(p^.nextnode);
  727.         end;
  728.     end;
  729.  
  730.   procedure findanddispose(var list: nodeptr);
  731.  
  732.     { This procedure finds and disposes the first number in the list
  733.       divisible by 8. }
  734.  
  735.     var
  736.       p, t: nodeptr;
  737.  
  738.     begin
  739.       p := list;
  740.       while (p^.nextnode <> nil) and (p^.nextnode^.thenum mod 8 <> 0) do
  741.         p := p^.nextnode;
  742.       delete(p);
  743.     end;
  744.  
  745.   procedure cleanup(var list: nodeptr);
  746.  
  747.     { This procedure removes the list from memory. }
  748.  
  749.     var
  750.       p, t: nodeptr;
  751.     begin
  752.       p := list;
  753.       while p <> nil do
  754.         begin
  755.           t := p^.nextnode;
  756.           dispose(p);
  757.           p := t;
  758.         end;
  759.     end;
  760.  
  761.   begin
  762.     clrscr;
  763.     writeln;writeln;
  764.     writeln('Free memory available: ', memavail, ' bytes.');
  765.     buildlist(list);
  766.     writeln('Free memory available: ', memavail, ' bytes.');
  767.     write('The list is: ');
  768.     writelist(list);
  769.     writeln;writeln;
  770.     writeln('Now we will insert a 20 in every third position');
  771.     insertbythree(list);
  772.     writeln('Free memory available: ', memavail, ' bytes.');
  773.     write('The list is: ');
  774.     writelist(list);
  775.     writeln;writeln;
  776.     write('Now we will search for and take the first # divisible by 8 ');
  777.     writeln('out of the list.');
  778.     findanddispose(list);
  779.     writeln('Free memory available: ', memavail, ' bytes.');
  780.     write('The list is: ');
  781.     writelist(list);
  782.     writeln;writeln;
  783.     writeln('Now we will be good little programmers and clean up our list. :)');
  784.     cleanup(list);
  785.     writeln('Free memory available: ', memavail, ' bytes.');
  786.   end.
  787.  
  788. Hopefully, you can go through here, and follow the logic (actually, you will
  789. need to do that successfully to understand what is going on).
  790.  
  791. Linked lists are very modular in nature.  Therefore, a good understanding
  792. of what is going on here is essential.  As a proof to be able to think
  793. through the logic of using pointers in linked structures, write out and
  794. logically explain on your sheet of paper how to perform the following
  795. (I will not provide a solution for this one -- code it up yourself and
  796. try and figure it out -- this is an important skill you will need to start
  797. developing as a programmer at this point, since you're at a pretty advanced
  798. level now (:))), and then code it up as a program:
  799.  
  800. 1) Create 1000 nodes in an SLLL that consists of integers numbered from 1
  801. to 1000.
  802. 2) Print this list to a text file.
  803. 3) Reverse the direction of the linked list.  By doing this, I mean, instead
  804. of the linked list looking like this conceptually:
  805.  
  806.                    NODE-->NODE-->NODE-->nil
  807.  
  808. make it look like this:
  809.  
  810.                    nil<--NODE<--NODE<--NODE
  811.  
  812. DO NOT CREATE ANOTHER LINKED LIST IN MEMORY.  USE THE CURRENT ONE YOU HAVE
  813. BUILT.
  814.  
  815. 4) Print the new list to the same text file.  Instead of it being from 1
  816. to 1000 as the first printing was, it should be from 1000 to 1.
  817.  
  818. CLUE: Think about how many temporary variables you will need (1?  Maybe 2?,
  819. Possibly 3?).
  820.  
  821. SLCL Concepts
  822. =============
  823. This is essentially the same as an SLLL, except instead of being nil at the
  824. end of the list, the end of the list points at the beginning of the list.
  825. This type uses the same record format as the SLLL.
  826.  
  827. Conceptually, an SLCL looks like this:
  828.  
  829.   NODE--->NODE--->NODE--->NODE--->NODE
  830.    ^                               |
  831.    |                               V
  832.   NODE                            NODE
  833.    ^                               |
  834.    |                               V
  835.   NODE<---NODE<---NODE<---NODE<---NODE
  836.  
  837. As before with the SLLL, one of these nodes would be denoted as the head
  838. of the list.
  839.  
  840. The only consideration that would differ that I could note, is that you
  841. would use a comparison of your temporary pointer with your head pointer
  842. in order to move through the list.
  843.  
  844. So instead of while p <> nil, it would be while p <> list in the above
  845. example to make it that way.
  846.  
  847. DLLL Concepts
  848. =============
  849. This type of linked list uses a different kind of record format.  It looks
  850. like this:
  851.  
  852. type
  853.   nodeptr = ^node;
  854.   node = record
  855.     ourinfo: integer;
  856.     lastnode, nextnode: nodeptr;
  857.   end;
  858.  
  859. Conceptually, a DLLL looks like this:
  860.  
  861.                 nil <--    <--    <--    <--
  862.                        NODE   NODE   NODE   NODE
  863.                            -->    -->    -->    --> nil
  864.  
  865. If you study up your logic from previously, this one shouldn't be too awfully
  866. bad to figure out.
  867.  
  868. DLCL Concepts
  869. =============
  870. This type of list uses the same record format as the DLLL.  The conceptual
  871. diagram looks much like the SLCL diagram, but with double links much like
  872. the DLLL diagram, instead of single links.
  873.  
  874. Final Thoughts on Linked Lists
  875. ==============================
  876. I did not provide examples of SLCLs, DLLLs, and DLCLs , merely for space,
  877. and also by the fact that I have never had reason to use the other three
  878. types.  I am presenting their basics here, merely for people's study, and
  879. learning.  Using the knowledge learned from doing those logic problems
  880. presented in the SLLLs, and references (though I find those to be VERY
  881. sparse on the types other than SLLL), you should be able to come up with
  882. the code to do the other three types pretty readily.  Always remember that
  883. the best thing to do to work out the logic of what to do with the pointers
  884. is to draw it out using the boxes and the arrows.
  885.  
  886. An Idea on Sorting Data Using Linked Lists
  887. ==========================================
  888. Here, I will now present the reasoning behind my "recursion" statement,
  889. plus an idea of sorting data upon build.  I don't have any stats on
  890. this being more or less efficient than using one of the array sorts,
  891. but if you can't use an array to sort in memory, you would have to resort
  892. to this.
  893.  
  894. Here is a little code/pseudocode (with a bent toward sorting names
  895. alphabetically)  For purposes of the recursion, we will call the
  896. function INSERT:
  897.  
  898. IF WE ARE TO PUT NODE HERE
  899.   GET DATA TO PUT INTO NODE (read data from file, or elsewhere)
  900. WHILE DATA IS NOT DONE DO
  901.   BEGIN
  902.     IF NIL LIST THEN
  903.       PUT NODE HERE
  904.     ELSE
  905.       PUT NODE HERE = NEWNAME <= NODE^.NAME
  906.     IF WE ARE TO PUT NODE HERE THEN
  907.       BEGIN
  908.         new(p);
  909.         SET DATA TO NODE
  910.         p^.nextnode := LIST;
  911.         if p^.nextnode = nil then
  912.           p^.nextnode^.nextnode = nil;
  913.         list := p;
  914.       END
  915.     ELSE
  916.       INSERT(LIST^.NEXTNODE);
  917.     IF WE ARE TO PUT NODE HERE THEN
  918.       BEGIN
  919.         GET INFO.
  920.         DO NOT PUT NODE HERE (boolean variable set to false).
  921.       END.
  922.   END.
  923.  
  924. This general code does work for a high capacity.  I have used this code 
  925. to sort a maximum of an 86KB list of 150 char items per line alphabetically
  926. using memory alone, no disk swapping.
  927.  
  928. For practice: Do things as I have suggested throughout this document.
  929. No real practice problem.
  930.  
  931. Next Time
  932. =========
  933. We will talk about binary trees.  Be sure to send comments to
  934. ggrotz@2sprint.net.  I will say again that I apologize for the long
  935. period of time it took to get this out.  I also apologize for the length
  936. this document has become.  Be sure to please comment on how this
  937. part is.
  938.